home *** CD-ROM | disk | FTP | other *** search
- /************************************************
- **
- ** *** HAPPy P-code Interpriter ***
- **
- ** メイン処理
- **
- ** Copyright (c) H.Asano. 1992.
- ************************************************/
-
- #define EXTERN
-
- #include <signal.h>
- #include <process.h>
- #include <io.h>
- #include <conio.h>
- #include <stdio.h>
- #include <stdlib.h>
- #include <string.h>
- #include <ctype.h>
- #include <math.h>
- #include <float.h>
- #include "version.h"
- #include "hapai.h"
-
- extern void callsp(void) ; /* call standard procedure */
- extern void T_get(int, _store*, FILE*,char*); /* 1文字読込 */
-
- _store store[Maxstore] ; /* 記憶装置 */
-
- _store *sp ; /* スタックポインタ */
- int pc ; /* program counter */
- int mp ; /* begginning of a data segment */
- int ep ; /* the maxmum extent of the stack */
- int np ; /* top of the dynamically allocated area */
-
- unsigned char p ; /* p operand */
- int q ; /* q operand */
-
- boolean readlnflag = true ; /* 起動時及びinputにreadlnをした時 真 */
-
-
- static char *pcofname = "pcode.pco" ; /* P-codeオブジェクトファイル名 */
- static char progname[33] ; /* Pascalプログラム名 */
-
- static int fileno ; /* ファイル数 */
- static int objsize ;
- static FILE *pcofile ;
- static boolean trace ; /* 命令トレースフラグ */
- static boolean infor = false ; /* -iオプション インタプリタ情報出力 */
-
- /******************************************/
- /* prerr() : Run-timeエラーメッセージ出力 */
- /******************************************/
- void prerr(int errno,char *msg)
- {
- int i ;
-
- fprintf(stderr,"\n*** [ADDR=%d] HAPPy Run-time error R%03d:\n -- %s",
- pc-1,errno,msg) ;
- fprintf(stderr," : 処理打ち切り ***\n");
-
- for(i=0;i<fileno;i++) { /* ファイルクローズを行う */
- if((fi[i].mode == generation) && /* 生成モードでテキストで */
- (fi[i].textfile) && (!fi[i].writelnflag)) /* 最後が改行でない*/
- fputc('\n',fi[i].fp) ; /* 改行を付け加える */
- fclose(fi[i].fp) ; /* エラーチェックはしない */
- }
-
- exit(1) ; /* 異常終了 */
- }
-
- /****************************************/
- /* cntl_c(): cntl_cが押された時の処理 */
- /****************************************/
- static void cntl_c(int sig,int subcode)
- {
- prerr(152,"<CTRL-C>を受け付けた");
- }
-
- /****************************************/
- /* real_err(): 浮動小数点例外 */
- /****************************************/
- static void real_err(int sig, int subcode)
- {
- char *type ;
- char buf[80] ;
-
- switch(subcode) {
- case FPE_INVALID : type = "invalid"; break ;
- case FPE_OVERFLOW : type = "overflow"; break ;
- case FPE_STACKOVERFLOW : type = "stack overflow"; break ;
- case FPE_STACKUNDERFLOW : type = "stack underflow"; break ;
- }
- sprintf(buf,"実数演算で異常が起きた(%s)",type) ;
- prerr(150,buf) ;
- }
-
- /***************************************/
- /* base(id) : 局所的番地を求める */
- /***************************************/
- static int base(void)
- {
- int ad ;
- int ld ;
-
- if(!p) return(mp) ; /* ldが0ならmp値を返す */
- ad = mp ;
- ld = p ;
- while((ld--)>0)
- ad = store[ad+1].va ;
- return(ad) ;
- }
-
- /************************ 各P-code の 処理 ****************************/
-
- /******************/
- /* ABI */ /* abolute integers */
- /******************/
- static void ABI(void)
- {
- (*sp).vi = labs((*sp).vi) ;
- }
-
- /******************/
- /* ABR */ /* abolute reals */
- /******************/
- static void ABR(void)
- {
- (*sp).vr = (float)fabs((double)(*sp).vr);
- }
-
- /******************/
- /* ADI */ /* add integers */
- /******************/
- static void ADI(void)
- {
- sp-- ;
- (*sp).vi += (*(sp+1)).vi ;
- }
-
- /******************/
- /* ADR */ /* add reals */
- /******************/
- static void ADR(void)
- {
- sp-- ;
- (*sp).vr += (*(sp+1)).vr ;
- }
-
- /******************/
- /* AND */ /* logical and */
- /******************/
- static void AND(void)
- {
-
- sp-- ;
- (*sp).vb = (*sp).vb && (*(sp+1)).vb ;
- }
-
- /******************/
- /* BAS */ /* load base mark */
- /******************/
- static void BAS(void)
- {
- (*++sp).va = base() ;
- }
-
- /******************/
- /* CHR */ /* convert character */
- /******************/
- static void CHR(void)
- {
- char buf[80] ;
-
- if((0L <= (*sp).vi) && ((*sp).vi <= 255L))
- (*sp).vc = (short)(*sp).vi ;
- else {
- sprintf(buf,"chr: 引数の値(%ld)に対応する文字がない",(*sp).vi);
- prerr(9,buf) ;
- }
- }
-
- /******************/
- /* CHK */
- /******************/
- static void CHK(void)
- {
- long i ;
- long s ; /* 集合 */
- char buf[80] ;
- static struct {
- int errno ;
- char *msg ;
- } errtbl[] = {
- { 1, "配列の添え字式の値(%ld)が範囲内(%ld~%ld)にない"},
- { 7, "実値引数の値(%ld)が範囲内(%ld~%ld)にない"},
- { 8, "実値引数の集合値が範囲内(%ld~%ld)にない"},
- { 17, "read: バッファ変数の値(%d)が範囲内(%ld~%ld)にない"},
- { 18, "write: 式の値(%ld)が範囲内(%ld~%ld)にない"},
- { 26, "pack: 順序型の引数の値(%ld)が範囲内(%ld~%ld)にない"},
- { 29, "unpack: 順序型の引数の値(%ld)が範囲内(%ld~%ld)にない"},
- { 31, "unpack: 転送後に詰めなし配列の添え字型を越える"},
- { 49, "代入文: 右辺値(%ld)が範囲内(%ld~%ld)にない"},
- { 50, "代入文: 集合値が範囲内(%ld~%ld)にない"},
- { 51, "case文: 選択式の値(%ld)に合致する選択定数がない"},
- { 52, "for文: 初期値(%ld)が範囲内(%ld~%ld)にない"},
- { 53, "for文: 終値(%ld)が範囲内(%ld~%ld)にない"},
- { 71, "read: 集合型のバッファ変数の値が範囲内(%ld~%ld)にない"},
- { 72, "write: 集合型の式の値が範囲内(%ld~%ld)にない"},
- {111, "集合構成子の順序式の値(%ld)がHAPPyの制限範囲内(%ld~%ld)にない"}
- } ;
-
- switch(store[pc-1].vo.cdop) {
- case 97 : /* chks (集合の範囲チェック) */
- s = 0 ;
- for(i=store[q-1].vi;i<=store[q].vi;i++)
- addset(s,i);
- s = (~s & (*sp).vs) ;
- if(s != 0) {
- i = -1;
- while(errtbl[++i].errno != p) ;
- sprintf(buf,errtbl[i].msg,
- store[q-1].vi,store[q].vi) ;
- prerr(p,buf) ; /* エラーメッセージ出力 */
- }
- break ;
-
- default : /* chks以外のチェック */
- if(((*sp).vi < store[q-1].vi) ||
- ((*sp).vi > store[q].vi)) {
- i = -1 ;
- while(errtbl[++i].errno != p) ;
- sprintf(buf,errtbl[i].msg,
- (*sp).vi, store[q-1].vi,store[q].vi) ;
- prerr(p,buf) ; /* エラーメッセージ出力 */
- }
- }
- }
-
- /******************/
- /* CKA */ /* Check Address */
- /******************/
- static void CKA(void)
- {
- if((*sp).va == NilValue)
- prerr(3,"対象変数のポインタ変数の値がnilである") ;
-
- if(!((np <= (*sp).va) && ((*sp).va < Maxstore)))
- prerr(4,"対象変数のポインタ変数の値が不定である") ;
- }
-
- /******************/
- /* CSP */ /* call standard procedure */
- /******************/
- static void CSP(void)
- {
- callsp() ;
- }
-
- /******************/
- /* CUI */ /* Call User procedure Indirect */
- /******************/
- static void CUI(void)
- {
- int calladr ;
-
- calladr = (*sp--).va ; /* 実行開始アドレス取得 */
- mp=(sp-store)-(p+4) ; /* 4はmstと関係 */
- store[mp+4].va = pc ; /* 戻り番地 */
- pc = calladr ; /* jump */
- }
-
- /******************/
- /* CUP */ /* Call User Procedure */
- /******************/
- static void CUP(void)
- {
- mp=(sp-store)-(p+4) ; /* 4はmstと関係*/
- store[mp+4].va = pc ; /* 戻り番地 */
- pc = q ; /* jump */
- }
-
- /******************/
- /* DEC */
- /******************/
- static void DEC(void)
- {
- switch(p) {
- case 1 : (*sp).vi -= q ;
- return ;
- case 6 : (*sp).vc -= q ;
- return ;
- case 3 : (*sp).vb -= q ;
- return ;
- case 0 : (*sp).va -= q ;
- return ;
- case 2 : (*sp).vr -= (float)q ;
- return ;
- }
- }
-
- /******************/
- /* DIF */
- /******************/
- static void DIF(void)
- {
- sp--;
- (*sp).vs &= ((*sp).vs ^ (*(sp+1)).vs) ;
- }
-
- /******************/
- /* DVI */
- /******************/
- static void DVI(void)
- {
- if((*sp--).vi == 0) prerr(45,"div演算子: 0で割ろうとしている") ;
- (*sp).vi /= (*(sp+1)).vi ;
- }
-
- /******************/
- /* DVR */
- /******************/
- static void DVR(void)
- {
- if((*sp--).vr == (float)0.0)
- prerr(44,"/演算子: 0で割ろうとしている") ;
- (*sp).vr /= (*(sp+1)).vr ;
- }
-
- /******************/
- /* EJP */ /* Extra block Jump */
- /******************/
- static void EJP(void)
- {
- int req ;
-
- req = base() ;
- while(mp != req) { /* スタックの枠を解放 */
- sp = store + mp-1;
- ep = store[mp+3].va;
- mp = store[mp+2].va;
- }
- pc = q;
- }
-
- /******************/
- /* ENT */
- /******************/
- static void ENT(void)
- {
- if(p==1) {
- if(q > np-mp) /* mp+q > np の時 */
- prerr(122,"スタック用のメモリが不足している") ;
- else sp = store + mp+q ;
- }
- else { /* p=2 */
- if( q > np-(sp-store)) /* sp+q > ep の時 */
- prerr(122,"スタック用のメモリが不足している") ;
- else ep = (sp-store)+q ; /* スタックの枠定義 */
- }
- }
-
- /******************/
- /* EQU */
- /******************/
- static void EQU(void)
- {
-
- sp-- ;
-
- switch(p) {
- case 1: (*sp).vb = (*sp).vi == (*(sp+1)).vi ;
- return;
- case 0: (*sp).vb = (*sp).va == (*(sp+1)).va ;
- return;
- case 6: (*sp).vb = (*sp).vc == (*(sp+1)).vc ;
- return;
- case 2: (*sp).vb = (*sp).vr == (*(sp+1)).vr ;
- return;
- case 3: (*sp).vb = (*sp).vb == (*(sp+1)).vb ;
- return;
- case 4: (*sp).vb = (*sp).vs == (*(sp+1)).vs ;
- return;
- case 5: (*sp).vb = (memcmp(&(store[(*sp).va].vc),
- &(store[(*(sp+1)).va].vc),
- q*sizeof(_store)) == 0);
- }
- }
-
- /******************/
- /* FJP */
- /******************/
- static void FJP(void)
- {
- if(! (*(sp--)).vb) pc = q;
- }
-
- /******************/
- /* FLO */
- /******************/
- static void FLO(void)
- {
- (*(sp-1)).vr = (float)(*(sp-1)).vi ;
- }
-
- /******************/
- /* FLT */
- /******************/
- static void FLT(void)
- {
- (*sp).vr = (float)(*sp).vi ;
- }
-
- /******************/
- /* GEQ */
- /******************/
- static void GEQ(void)
- {
- sp-- ;
- switch(p) {
- case 1: (*sp).vb = (*sp).vi >= (*(sp+1)).vi ;
- return;
- case 6: (*sp).vb = (*sp).vc >= (*(sp+1)).vc ;
- return;
- case 2: (*sp).vb = (*sp).vr >= (*(sp+1)).vr ;
- return;
- case 3: (*sp).vb = (*sp).vb >= (*(sp+1)).vb ;
- return;
- case 4: (*sp).vb =
- ((*(sp+1)).vs & ((*(sp+1)).vs ^ (*sp).vs))
- ? false : true ;
- return;
- case 5: (*sp).vb = (memcmp(&(store[(*sp).va].vc),
- &(store[(*(sp+1)).va].vc),
- q*sizeof(_store)) >= 0);
- }
- }
-
- /******************/
- /* GRT */
- /******************/
- static void GRT(void)
- {
- sp-- ;
- switch(p) {
- case 1: (*sp).vb = (*sp).vi > (*(sp+1)).vi ;
- return;
- case 6: (*sp).vb = (*sp).vc > (*(sp+1)).vc ;
- return;
- case 2: (*sp).vb = (*sp).vr > (*(sp+1)).vr ;
- return;
- case 3: (*sp).vb = (*sp).vb > (*(sp+1)).vb ;
- return;
- case 5: (*sp).vb = (memcmp(&(store[(*sp).va].vc),
- &(store[(*(sp+1)).va].vc),
- q*sizeof(_store)) > 0);
- }
- }
-
- /******************/
- /* INC */
- /******************/
- static void INC(void)
- {
- switch(p) {
- case 1 : (*sp).vi += q ;
- return ;
- case 6 : (*sp).vc += q ;
- return ;
- case 3 : (*sp).vb += q ;
- return ;
- case 0 : (*sp).va += q ;
- return ;
- case 2 : (*sp).vr += (float)q ;
- return ;
- }
- }
-
- /******************/
- /* IND */
- /******************/
- static void IND(void)
- {
- (*sp)=store[(*sp).va+q] ;
- }
-
- /******************/
- /* INN */
- /******************/
- static void INN(void)
- {
- integer i;
-
- i=(*(--sp)).vi ;
- (*sp).vb = (boolean)inset((*(sp+1)).vs,i) ;
- }
-
- /******************/
- /* INT */
- /******************/
- static void INT(void)
- {
- sp--;
- (*sp).vs &= (*(sp+1)).vs ;
- }
-
- /******************/
- /* IOR */ /* logical inclusive or */
- /******************/
- static void IOR(void)
- {
- sp-- ;
- (*sp).vb = (*sp).vb || (*(sp+1)).vb ;
- }
-
- /******************/
- /* IXA */
- /******************/
- static void IXA(void)
- {
- (*sp).vi -= store[q-1].vi ; /* 下限値を引く */
- (*sp).va += (int)store[q].vi*(int)(*(sp--)).vi ;
- }
-
- /******************/
- /* LAO */ /* load base-level address */
- /******************/
- static void LAO(void)
- {
- (*(++sp)).va = q ;
- }
-
- /******************/
- /* LAP */ /* Load Address Procedure */
- /******************/
- static void LAP(void)
- {
- (*(++sp)).va = q ;
- }
-
- /******************/
- /* LCA */
- /******************/
- static void LCA(void)
- {
- (*(++sp)).va = q ;
- }
-
- /******************/
- /* LCI */ /* load constant integer */
- /******************/
- static void LCI(void)
- {
- (*(++sp)).vi = store[q].vi ;
- }
-
- /******************/
- /* LDA */ /* load level p address */
- /******************/
- static void LDA(void)
- {
- (*(++sp)).va = base()+q ;
- }
-
- /******************/
- /* LDC */ /* load constant */
- /******************/
- static void LDC(void)
- {
- sp++ ;
- switch(p) {
- case 1 : (*sp).vi = q; /* integer */
- return ;
- case 6 : (*sp).vc = q; /* char */
- return ;
- case 3 : (*sp).vb = q; /* boolean */
- return ;
- case 2 : (*sp).vr = store[q].vr; /* real */
- return ;
- case 4 : (*sp).vs = store[q].vs ;/* set */
- return ;
- case 0 : (*sp).va = NilValue ; /* nil */
- /* programmer が 生成できない値 */
- }
- }
-
- /******************/
- /* LDO */ /* load contents of base-level address */
- /******************/
- static void LDO(void)
- {
- (*(++sp))=store[q] ;
- }
-
- /******************/
- /* LDOC */ /* load char of base-level address */
- /******************/
- /* inputバッファの値が決まっていない時のために
- 特別な処理が必要なので、この処理を作りました */
- static void LDOC(void)
- {
- if((q == fi[0].fileadr) && readlnflag) {
- T_get(0,store+fi[0].fileadr,stdin,"get");
- readlnflag = false ;
- }
-
- *(++sp) = store[q] ;
- }
-
- /******************/
- /* LEQ */
- /******************/
- static void LEQ(void)
- {
- sp-- ;
- switch(p) {
- case 1: (*sp).vb = (*sp).vi <= (*(sp+1)).vi ;
- return;
- case 6: (*sp).vb = (*sp).vc <= (*(sp+1)).vc ;
- return;
- case 2: (*sp).vb = (*sp).vr <= (*(sp+1)).vr ;
- return;
- case 3: (*sp).vb = (*sp).vb <= (*(sp+1)).vb ;
- return;
- case 4: (*sp).vb =
- ((*sp).vs & ((*sp).vs ^ (*(sp+1)).vs))
- ? false : true ;
- return;
- case 5: (*sp).vb = (memcmp(&(store[(*sp).va].vc),
- &(store[(*(sp+1)).va].vc),
- q*sizeof(_store)) <= 0);
- }
- }
-
- /******************/
- /* LES */
- /******************/
- static void LES(void)
- {
- sp-- ;
- switch(p) {
- case 1: (*sp).vb = (*sp).vi < (*(sp+1)).vi ;
- return;
- case 6: (*sp).vb = (*sp).vc < (*(sp+1)).vc ;
- return;
- case 2: (*sp).vb = (*sp).vr < (*(sp+1)).vr ;
- return;
- case 3: (*sp).vb = (*sp).vb < (*(sp+1)).vb ;
- return;
- case 5: (*sp).vb = (memcmp(&(store[(*sp).va].vc),
- &(store[(*(sp+1)).va].vc),
- q*sizeof(_store)) < 0);
- }
- }
-
- /******************/
- /* LOD */ /* load contents of address at level p */
- /******************/
- static void LOD(void)
- {
-
- *(++sp)=store[base()+q];
- }
-
- /******************/
- /* MMS */ /* Make Multiple Set */
- /******************/
- static void MMS(void)
- {
- long s = 0;
- integer i ;
-
- sp-- ;
- for(i=(*sp).vi;i<=(*(sp+1)).vi;i++)
- addset(s,i);
- (*sp).vs = s;
- }
-
- /******************/
- /* MOD */
- /******************/
- static void MOD(void)
- {
- if((*sp--).vi <= 0)
- prerr(46,"mod演算子: 右辺値が0または負である") ;
- (*sp).vi %= (*(sp+1)).vi ;
- }
-
- /******************/
- /* MOV */
- /******************/
- static void MOV(void)
- {
- if(p==1)
- memcpy(&store[(*(sp-1)).va],
- &store[(*sp).va], q*sizeof(_store)) ;
- else /* pack,unpackの時使う */
- memcpy(&store[(*sp).va],
- &store[(*(sp-1)).va], q*sizeof(_store)) ;
-
- sp-=2 ;
-
- }
-
- /******************/
- /* MPI */
- /******************/
- static void MPI(void)
- {
- sp--;
- (*sp).vi *= (*(sp+1)).vi ;
- }
-
- /******************/
- /* MPR */
- /******************/
- static void MPR(void)
- {
- sp--;
- (*sp).vr *= (*(sp+1)).vr ;
- }
-
- /******************/
- /* MSI */ /* Mark Stack Indirect */
- /******************/
- static void MSI(void)
- {
- (*(sp+2)).va = (unsigned char)(*(sp--)).va ; /* 静鎖 */
- (*(sp+3)).va = mp ; /* 動鎖 */
- (*(sp+4)).va = ep ; /* 旧ep */
- sp += 5 ;
- }
-
- /******************/
- /* MST */ /* Mark STack */
- /******************/
- static void MST(void)
- {
- (*(sp+2)).va = base() ; /* 静鎖 */
- (*(sp+3)).va = mp ; /* 動鎖 */
- (*(sp+4)).va = ep ; /* 旧ep */
- sp += 5 ;
- }
-
- /******************/
- /* NEQ */
- /******************/
- static void NEQ(void)
- {
- sp-- ;
- switch(p) {
- case 1: (*sp).vb = (*sp).vi != (*(sp+1)).vi ;
- return;
- case 0: (*sp).vb = (*sp).va != (*(sp+1)).va ;
- return;
- case 6: (*sp).vb = (*sp).vc != (*(sp+1)).vc ;
- return;
- case 2: (*sp).vb = (*sp).vr != (*(sp+1)).vr ;
- return;
- case 3: (*sp).vb = (*sp).vb != (*(sp+1)).vb ;
- return;
- case 4: (*sp).vb = (*sp).vs != (*(sp+1)).vs ;
- return;
- case 5: (*sp).vb = (memcmp(&(store[(*sp).va].vc),
- &(store[(*(sp+1)).va].vc),
- q*sizeof(_store)) != 0);
- }
- }
-
- /******************/
- /* NGI */
- /******************/
- static void NGI(void)
- {
- (*sp).vi = - (*sp).vi ;
- }
-
- /******************/
- /* NGR */
- /******************/
- static void NGR(void)
- {
- (*sp).vr = - (*sp).vr ;
- }
-
- /******************/
- /* NOP */ /* no operation */ /* 現在使われていません */
- /******************/
- static void NOP(void)
- {
- }
-
- /******************/
- /* NOT */
- /******************/
- static void NOT(void)
- {
- (*sp).vb = ! (*sp).vb ;
- }
-
- /******************/
- /* ODD */
- /******************/
- static void ODD(void)
- {
- (*sp).vb = (((*sp).vi % 2) == 0) ? false : true ;
- }
-
- /******************/
- /* ORD */ /* ORdinary */
- /******************/
- static void ORD(void)
- {
- if(p == 3) /* ordb */
- (*sp).vi = (integer)(*sp).vb ;
- else /* ordc */
- (*sp).vi = (integer)(*sp).vc ;
- }
-
- /******************/
- /* RET */
- /******************/
- static void RET(void)
- {
- if(p) sp = store + mp ; /* retp:p=0 p<>0は以下の命令 */
- else sp = store + mp - 1 ; /* reti,retr,retc,retb,rets */
- pc = store[mp+4].va ; /* pc 復帰 */
- ep = store[mp+3].va ; /* ep 復帰 */
- mp = store[mp+2].va ; /* mp 復帰 */
- }
-
- /******************/
- /* ROU */ /* round */
- /******************/
- static void ROU(void)
- {
- (*sp).vi = (integer)floor((double)((*sp).vr + 0.5)) ;
- }
-
- /******************/
- /* SBI */ /* subtruct integers */
- /******************/
- static void SBI(void)
- {
- sp-- ;
- (*sp).vi -= (*(sp+1)).vi ;
- }
-
- /******************/
- /* SBR */ /* subtruct reals */
- /******************/
- static void SBR(void)
- {
- sp-- ;
- (*sp).vr -= (*(sp+1)).vr ;
- }
-
- /******************/
- /* SGS */
- /******************/
- static void SGS(void)
- {
- long s = 0;
-
- addset(s,(*sp).vi);
- (*sp).vs = s;
- }
-
- /******************/
- /* SQI */
- /******************/
- static void SQI(void)
- {
- (*sp).vi *= (*sp).vi ;
- }
-
- /******************/
- /* SQR */
- /******************/
- static void SQR(void)
- {
- (*sp).vr *= (*sp).vr ;
- }
-
- /******************/
- /* SRO */ /* store at base-level address */
- /******************/
- static void SRO(void)
- {
- store[q] = *(sp--) ;
- }
-
- /******************/
- /* STO */
- /******************/
- static void STO(void)
- {
- store[(*(sp-1)).va] = *sp ;
- sp-=2 ;
- }
-
- /******************/
- /* STP */ /* stop */
- /******************/
- static void STP(void)
- {
- int i ;
-
- for(i=0;i<fileno;i++) { /* ファイルクローズを行う */
- if((fi[i].mode == generation) && /* 生成モードでテキストで */
- (fi[i].textfile) && (!fi[i].writelnflag)) /* 最後が改行でない*/
- fputc('\n',fi[i].fp) ; /* 改行を付け加える */
- fclose(fi[i].fp) ; /* エラーチェックはしない */
- }
- exit(0) ;
- }
-
- /******************/
- /* STR */ /* store contents at address at level p */
- /******************/
- static void STR(void)
- {
- store[base()+q] = *sp-- ;
- }
-
- /******************/
- /* TRA */ /* trace of execuction */
- /******************/
- static void TRA(void)
- {
- trace = (p==1) ; /* tra 1 の時 トレースON */
- }
-
- /******************/
- /* TRC */ /* truncate */
- /******************/
- static void TRC(void)
- {
- (*sp).vi = (integer)(*sp).vr ;
- }
-
- /******************/
- /* UDF */ /* UnDeFined instruction */
- /******************/
- static void UDF(void)
- {
- prerr(142,"未定義命令を実行しようとした") ;
- }
-
- /******************/
- /* UJC */
- /******************/
- static void UJC(void)
- {
- prerr(51,"case文: 選択式の値に合致する選択定数がない") ;
- }
-
- /******************/
- /* UJP */
- /******************/
- static void UJP(void)
- {
- pc = q;
- }
-
- /******************/
- /* UNI */
- /******************/
- static void UNI(void)
- {
- sp-- ;
- (*sp).vs |= (*(sp+1)).vs ;
- }
-
- /******************/
- /* XJP */
- /******************/
- static void XJP(void)
- {
- pc = (int)(*sp--).vi+q;
- }
-
-
- /**********************************************************************/
- /* P-code 別 処理エントリ表 */
- /**********************************************************************/
-
- static struct entry {
- void (*func)(void) ;
- } pcd[] = {
- /* xx0 xx1 xx2 xx3 xx4 xx5 xx6 xx7 xx8 xx9 */
-
- /*00x*/ LOD, LDO, STR, SRO, LDA, LAO, STO, LDC, BAS, IND,
- /*01x*/ INC, MST, CUP, ENT, RET, CSP, IXA, EQU, NEQ, GEQ,
- /*02x*/ GRT, LEQ, LES, UJP, FJP, XJP, CHK, LAP, ADI, ADR,
- /*03x*/ SBI, SBR, SGS, FLT, FLO, TRC, NGI, NGR, SQI, SQR,
- /*04x*/ ABI, ABR, NOT, AND, IOR, DIF, INT, UNI, INN, MOD,
- /*05x*/ ODD, MPI, MPR, DVI, DVR, MOV, LCA, DEC, STP, ORD,
- /*06x*/ CHR, UJC, MMS, MSI, CUI, EJP, LCI, CKA, TRA, ROU,
- /*07x*/ STR, STR, STR, STR, STR, SRO, SRO, SRO, SRO, SRO,
- /*08x*/ STO, STO, STO, STO, STO, IND, IND, IND, IND, IND,
- /*09x*/ UDF, UDF, UDF, UDF, UDF, UDF, CHK, CHK, CHK, CHK,
- /*10x*/ UDF, UDF, UDF, UDF, UDF, LDO, LDO, LDO, LDO, LDOC,
- /*11x*/ UDF, UDF, UDF, UDF, UDF, LOD, LOD, LOD, LOD, LOD,
- /*12x*/ UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
- /*13x*/ UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
- /*14x*/ UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
- /*15x*/ UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
- /*16x*/ UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
- /*17x*/ UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
- /*18x*/ UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
- /*19x*/ UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
- /*20x*/ UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
- /*21x*/ UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
- /*22x*/ UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
- /*23x*/ UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
- /*24x*/ UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
- /*25x*/ UDF, UDF, UDF, UDF, UDF, UDF
- };
-
- /***************************************/
- /* information() : インタプリタ情報出力処理 */
- /***************************************/
- static void information(void)
- {
- fprintf(stderr,
- "HAPPy P-code Interpriter Version %s Copyright (c) H.Asano 1992\n",
- version) ;
- fputs("\n HAPPy is the H.Asano Pascal Processing system. (^_^)\n",
- stderr);
- fputs(
- "\n HAPPyはISO7185規格水準0にほぼ準拠したMS-DOS汎用Pascal処理系です。\n",
- stderr) ;
- fputs(" HAPPyの複写・再配付は自由です。\n", stderr) ;
-
- fputs("\n piコマンドはpcコマンドで作ったP-codeオブジェクト(pcode.pco)を実行します。\n",
- stderr);
- }
-
- /*****************************************/
- /* inputfilename() : ファイル名入力処理 */
- /*****************************************/
- static void inputfilename(void)
- {
- int i,j ;
- int ch ;
-
- fputs("*HAPPy: ファイル( ",stderr) ;
- for(i=2;i<fileno;i++) fprintf(stderr,"%s ",fi[i].filename) ;
- fputs(")の実ファイル名を入力して下さい\n",stderr);
-
- for(i=2;i<fileno;i++) {
- fi[i].textfile = false ; /* とりあえずテキストでない */
- /* としておく */
- fprintf(stderr," %s : ",fi[i].filename) ;
- while(((ch=getc(stdin)) == ' ') || (ch == '\t'));
- /* 空白,タブの読み飛ばし */
- j = 0 ;
- while(ch != '\n') {
- fi[i].rfname[j++] = (char)ch ;
- if(j == MaxRFlen) break ;
- ch = getc(stdin) ;
- } ;
- fi[i].rfname[j] = '\0' ;
- }
-
- fprintf(stderr,"\n*HAPPy: プログラム(%s)を実行します\n",progname);
- }
-
- /***************************************/
- /* init() : 初期設定処理 */
- /***************************************/
- static void init(int argc, char **argv)
- {
- int i,j ;
- char ch ;
- int headerlen ; /* ヘッダ部分の長さ */
- char compversion[6] ; /* コンパイラバージョン番号 */
-
- for(i=2;i<=argc;i++) { /* オプションの処理 */
- if(**++argv == '-') {
- for(j=1;*(*argv+j)!='\0';j++) {
- switch(tolower(*(*argv+j))) { /* 大文字の時は小文字に変換 */
- case 'i' : infor = true ; /* information option */
- break ;
- case 't' : trace = true ; /* trace option */
- break ;
- }
- }
- }
- }
-
- if(infor) information() ; /* インタプリタ情報出力 */
-
- /**** input,outputファイルのファイル情報を設定する
- この部分は、暫定的であり、将来変更する予定です ****/
-
- strcpy(fi[0].filename,"input") ;
- fi[0].fileadr = 5 ; /* 5はinputアドレス */
- fi[0].filesize = 1 ;
- strcpy(fi[0].rfname,"標準入力") ;
- fi[0].fp = stdin ; /* 標準入力 */
- fi[0].mode = inspection ; /* 検査モード */
- fi[0].textfile = true ; /* テキストファイル */
-
- strcpy(fi[1].filename,"output") ;
- fi[1].fileadr = 6 ; /* 6はoutputアドレス */
- fi[1].filesize = 1 ;
- strcpy(fi[1].rfname,"標準出力") ;
- fi[1].fp = stdout ; /* 標準出力 */
- fi[1].mode = generation ; /* 生成モード */
- fi[1].textfile = true ; /* テキストファイル */
- fi[1].writelnflag = true ;
-
- fileno = 2 ;
-
-
- pcofile = fopen(pcofname,"rb");
- if(pcofile==NULL) {
- fprintf(stderr,
- "I001: P-codeオブジェクトファイル(%s)がない\n",pcofname);
- exit(2);
- }
- objsize = (int)filelength(fileno(pcofile));
- i = 0 ;
- do { /* バージョン番号を読む */
- ch = (char)fgetc(pcofile) ;
- if(feof(pcofile)) { /* 途中でファイルが終わってしまった*/
- fprintf(stderr,
- "I002: P-codeオブジェクトファイル(%s)が不当である",pcofname) ;
- exit(2) ;
- }
- } while((compversion[i++]=ch) != '\0') ;
- headerlen = i ;
- if(strcmp(compversion,version)) {
- fprintf(stderr,
- "I003: コンパイラ(Version %s)とインタプリタ(Version %s)のバージョンが違う\n",
- compversion, version) ;
-
- exit(2);
- }
- i = 0 ;
- do { /* プログラム名を読む */
- progname[i] = (char)fgetc(pcofile) ;
- } while(progname[i++] != '\0') ;
- headerlen += i ;
-
- while((fi[fileno].fileadr = getw(pcofile)) != -1) {
- headerlen += sizeof(int) ;
- fi[fileno].filesize = getw(pcofile) ; /* バッファ変数の大きさ */
- headerlen += sizeof(int) ;
- i = 0 ;
- do { /* ファイル名を読む */
- fi[fileno].filename[i] = (char)fgetc(pcofile) ;
- } while(fi[fileno].filename[i++] != '\0') ;
- fi[fileno].mode = undefined ; /* ファイルモードは不定 */
-
- headerlen += i ;
- fileno++ ;
- }
- if(feof(pcofile)) { /* コード部分がない場合 */
- fprintf(stderr,
- "I002: P-codeオブジェクトファイル(%s)が不当である",pcofname) ;
- exit(2) ;
- }
-
- headerlen += sizeof(int) ;
- objsize = objsize - headerlen ;
- fread((char*)store,objsize,1,pcofile) ; /* P-codeオブジェクトを読む*/
- objsize /= sizeof(_store) ;
-
- if(infor) {
- fprintf(stderr,"\n * Program name = %s\n",progname) ;
- fprintf(stderr," * Total memory = %4d words\n",Maxstore) ;
- fprintf(stderr," * Object size = %4d words\n",objsize) ;
- fprintf(stderr," * stack/heap = %4d words\n\n",Maxstore-objsize) ;
- }
-
- if(fileno>2) inputfilename() ;
-
- signal(SIGINT,cntl_c) ; /* CTRL-Cシグナル登録 */
- signal(SIGFPE,real_err) ; /* 実数演算シグナル登録 */
- }
-
- /*******************************************/
- /* pitpr() : P-codeインタプリタメイン処理 */
- /*******************************************/
- void main(int argc,char **argv)
- {
- register _store *adrinst ;
- int i ;
-
- init(argc,argv) ;
-
- pc = 0 ;
- mp = objsize ;
- np = Maxstore ;
- ep = objsize+5 ;
- sp = store+objsize-1 ; /* スタックポインタの初期設定 */
-
-
- for(i=0;i<fileno;i++) {
- fi[i].fileadr += objsize ; /* ファイルアドレスの修正 */
- fi[i].filebuf = store + fi[i].fileadr ; /* バッファ変数アドレス*/
- }
-
- loop :
- adrinst = store + pc++ ;
- p = (*adrinst).vo.cdp ;
- q = (*adrinst).vo.cdq ;
-
- if(trace) /* トレースオプション有効 */
- printf("%4d[%3d %1d %6d] mp=%4d np=%4d ep=%4d stack[%4d]=%08lxH\n",
- pc-1,(*adrinst).vo.cdop,p,q, mp,np,ep,sp-store,(*sp).vi);
-
- pcd[(*adrinst).vo.cdop].func() ; /* opに対応した命令を実行 */
-
- goto loop;
- }